---
title: "Data Viz Final Project"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
social: menu
source_code: embed
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(rio)
library(colorblindr)
library(janitor)
library(magrittr)
library(ggrepel)
library(fontawesome)
```
```{r import data}
data_raw <- import("http://bchi.bigcitieshealth.org/rails/active_storage/blobs/eyJfcmFpbHMiOnsibWVzc2FnZSI6IkJBaHBGdz09IiwiZXhwIjpudWxsLCJwdXIiOiJibG9iX2lkIn19--c6b5c30fbd8b79859797e1dc260a06064c8f3864/Current%20BCHI%20Platform%20Dataset%20(7-18)%20-%20Updated%20BCHI%20Platform%20Dataset%20-%20BCHI,%20Phase%20I%20&%20II.csv?disposition=attachment")
# wrangle data
data_filt <- data_raw %>%
clean_names() %>%
select(shortened_indicator_name, year, sex, race_ethnicity, value, place) %>%
filter(shortened_indicator_name %in% c("Adult Physical Activity Levels", "Teen Physical Activity Levels", "Adult Binge Drinking","Adult Obesity","Heart Disease Mortality Rate","Bike Score","Walkability","Median Household Income","Race/Ethnicity","Death Rate (Overall)")) %>%
mutate(value = as.numeric(value)) %>%
mutate_at(c("sex", "race_ethnicity", "place"), factor) %>%
mutate(place = plyr::mapvalues(x = .$place, from = c("Fort Worth (Tarrant County), TX", "Indianapolis (Marion County), IN", "Las Vegas (Clark County), NV", "Miami (Miami-Dade County), FL", "Oakland (Alameda County), CA", "Portland (Multnomah County), OR"), to = c("Fort Worth, TX", "Indianapolis, IN", "Las Vegas, NV", "Miami, FL", "Oakland, CA", "Portland, OR"))) %>%
na.omit()
```
# Obesity by City {data-icon="fa-map-marker-alt"}
```{r}
# wrangle data
data_obesity <- data_filt %>%
filter(shortened_indicator_name == "Adult Obesity") %>%
spread(shortened_indicator_name, value) %>%
group_by(place) %>%
summarise(avg_obesity = mean(`Adult Obesity`, na.rm = TRUE),
se_obesity = sundry::se(`Adult Obesity`))
```
Column {data-width=650}
-----------------------------------------------------------------------
### Final plot
```{r}
data_obesity %>%
mutate(compare_us_tot = ifelse(
avg_obesity > .$avg_obesity[which(data_obesity$place == "U.S. Total")], "above",
ifelse(avg_obesity < .$avg_obesity[which(data_obesity$place == "U.S. Total")], "below", "avg"))) %>%
ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) +
geom_col(aes(fill = compare_us_tot), alpha = 0.8) +
coord_flip() +
scale_y_continuous(labels = scales::percent_format(scale = 1)) +
scale_fill_manual(values = c("#BA4A00", "black", "#ABCFF7")) +
labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL, caption = "States above the U.S. average are colored red. States below the U.S. average are colored green.") +
theme_minimal() +
geom_hline(yintercept = data_obesity$avg_obesity[which(data_obesity$place == "U.S. Total")], linetype = 2) +
theme(legend.position = "none")
```
Column {.tabset data-width=350}
-----------------------------------------------------------------------
### Version 1
```{r}
data_obesity %>%
ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) +
geom_col() +
coord_flip()
```
### Version 2
```{r}
data_obesity %>%
ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) +
geom_col() +
coord_flip() +
scale_y_continuous(labels = scales::percent_format(scale = 1)) +
labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL) +
theme_minimal()
```
### Version 3
```{r}
data_obesity %>%
mutate(compare_us_tot = ifelse(
avg_obesity > .$avg_obesity[which(data_obesity$place == "U.S. Total")], "above",
ifelse(avg_obesity < .$avg_obesity[which(data_obesity$place == "U.S. Total")], "below", "avg"))) %>%
ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) +
geom_segment(aes(color = compare_us_tot, x = fct_reorder(place, avg_obesity), xend = place, y=0, yend = avg_obesity), size = 1, alpha = 0.7) +
geom_point(aes(color = compare_us_tot), size = 3, alpha = 0.7) +
coord_flip() +
scale_y_continuous(labels = scales::percent_format(scale = 1)) +
scale_color_manual(values = c("#BA4A00", "black", "#ABCFF7")) +
labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL, caption = "States above the U.S. average are colored red. States below the U.S. average are colored green.") +
theme_minimal() +
geom_hline(yintercept = data_obesity$avg_obesity[which(data_obesity$place == "U.S. Total")], linetype = 2) +
theme(legend.position = "none")
```
### Version 4
```{r}
data_obesity %>%
mutate(compare_us_tot = ifelse(
avg_obesity > .$avg_obesity[which(data_obesity$place == "U.S. Total")], "above",
ifelse(avg_obesity < .$avg_obesity[which(data_obesity$place == "U.S. Total")], "below", "avg"))) %>%
ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) +
geom_errorbar(aes(ymin = avg_obesity - 1.96*se_obesity,
ymax = avg_obesity + 1.96*se_obesity),
color = "gray40") +
geom_point(aes(color = compare_us_tot), size = 4, alpha = 0.7) +
coord_flip() +
scale_y_continuous(labels = scales::percent_format(scale = 1)) +
scale_color_manual(values = c("#BA4A00", "black", "#ABCFF7")) +
labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL, caption = "States above the U.S. average are colored red. States below the U.S. average are colored green.") +
theme_minimal() +
geom_hline(yintercept = data_obesity$avg_obesity[which(data_obesity$place == "U.S. Total")], linetype = 2) +
theme(legend.position = "none")
```
# Obesity x Heart Disease {data-icon="fa-heartbeat"}
```{r}
# wrangle data
obesity_hdmr <- data_filt %>%
filter(shortened_indicator_name %in% c("Adult Obesity", "Heart Disease Mortality Rate"),
sex == "Both",
race_ethnicity == "All",
place != "U.S. Total") %>%
mutate(i = row_number()) %>%
spread(shortened_indicator_name, value) %>%
group_by(place) %>%
summarize(avg_obesity = mean(`Adult Obesity`, na.rm = TRUE),
avg_hdmr = mean(`Heart Disease Mortality Rate`, na.rm = TRUE))
```
Column {data-width=650}
-----------------------------------------------------------------------
### Final plot
```{r}
## 3 most obese cities
top_3_obese <- obesity_hdmr %>%
top_n(3, avg_obesity)
## 3 least obese cities
bottom_3_obese <- obesity_hdmr %>%
top_n(-3, avg_obesity)
obesity_hdmr %>%
ggplot(aes(avg_obesity, avg_hdmr)) +
geom_point(size = 5, alpha = 0.7, color = "gray70") +
geom_point(data = top_3_obese, size = 5, color = "#BA4A00") +
geom_point(data = bottom_3_obese, size = 5, color = "#ABCFF7") +
geom_smooth(method = "lm", alpha = 0.2, color = "gray60") +
geom_text_repel(data = top_3_obese, aes(label = place), min.segment.length = 0) +
geom_text_repel(data = bottom_3_obese, aes(label = place), min.segment.length = 0) +
theme_minimal() +
scale_x_continuous(labels = scales::percent_format(scale = 1)) +
labs(x = "Percent Obese", y = "Heart Disease Mortality Rate", title = "Relationship between Obesity and Heart Disease", subtitle = "State labels represent 3 most/least obese states", caption = "3 most/least obese states are colored red/green, respectively. \n Heart Disease Mortality Rate is age-adjusted per 100,000 people.")
```
Column {.tabset data-width=350}
-----------------------------------------------------------------------
### Version 1
```{r}
obesity_hdmr %>%
ggplot(aes(avg_obesity, avg_hdmr)) +
geom_point() +
geom_smooth(method = "lm")
```
### Version 2
```{r}
obesity_hdmr %>%
ggplot(aes(avg_obesity, avg_hdmr)) +
geom_point() +
geom_smooth(method = "lm") +
geom_text_repel(aes(label = place)) +
theme_minimal()
```
# Opioid-related Deaths {data-icon="fa-pills"}
```{r}
# wrangle data
data_opioid <- data_raw %>%
clean_names() %>%
select(shortened_indicator_name, year, sex, race_ethnicity, value, place) %>%
filter(shortened_indicator_name %in% c("Opioid-Related Overdose Mortality Rate")) %>%
mutate(value = as.numeric(value)) %>%
mutate_at(c("sex", "race_ethnicity", "place"), factor) %>%
na.omit()
# identify city with highest opioid-related overdose mortality rate from 2010 to 2016
top_opioid = data_opioid %>%
filter(sex == "Both",
race_ethnicity == "All",
place != "U.S. Total",
year %in% 2010:2016) %>%
unique() %>%
spread(shortened_indicator_name, value) %>%
group_by(place) %>%
summarize(mean_opioid = mean(`Opioid-Related Overdose Mortality Rate`, na.rm = TRUE)) %>%
top_n(1) %>%
select(place)
```
Column {data-width=650}
-----------------------------------------------------------------------
### Final plot
```{r}
data_opioid %>%
filter(sex != "Both",
race_ethnicity == "All",
place == top_opioid$place,
year %in% 2010:2016) %>%
spread(shortened_indicator_name, value) %>%
ggplot(aes(year, `Opioid-Related Overdose Mortality Rate`, color= sex)) +
geom_line(size= 2) +
geom_point(size = 4) +
labs(x = NULL, y = "Opioid-Related Overdose Mortality Rate", title = "Opioid-use Related Mortality Rates Over Time", subtitle = "Colombus, OH", caption = "Rates are age-adjusted per 100,000 people.") +
theme_minimal() +
scale_color_OkabeIto() +
theme(legend.position = "none") +
geom_label(data = data_opioid %>%
filter(sex != "Both",
race_ethnicity == "All",
place == top_opioid$place,
year == 2016) %>%
spread(shortened_indicator_name, value),
aes(y =`Opioid-Related Overdose Mortality Rate`, label = sex),
nudge_x = -0.7,
size = 5)
```
Column {.tabset data-width=350}
-----------------------------------------------------------------------
### Version 1
```{r}
data_opioid %>%
filter(sex != "Both",
race_ethnicity == "All",
place == top_opioid$place,
year %in% 2010:2016) %>%
spread(shortened_indicator_name, value) %>%
ggplot(aes(year, `Opioid-Related Overdose Mortality Rate`, color= sex)) +
geom_line()
```
### Version 2
```{r}
data_opioid %>%
filter(sex != "Both",
race_ethnicity == "All",
place == top_opioid$place,
year %in% 2010:2016) %>%
spread(shortened_indicator_name, value) %>%
ggplot(aes(year, `Opioid-Related Overdose Mortality Rate`, color= sex)) +
geom_line(size= 2) +
geom_point(size = 4) +
labs(x = NULL, y = "Opioid-Related Overdose Mortality Rate", title = "Opioid-use Related Mortality Rates Over Time", subtitle = "Colombus, OH", caption = "Rates are age-adjusted per 100,000 people.") +
theme_minimal()
```
